home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 02 / 1 / DISK0217.ZIP / NEINST.PAS < prev    next >
Pascal/Delphi Source File  |  1984-08-15  |  11KB  |  330 lines
  1. Program NEInst (input,output,F);                                      {.CP19}
  2.    {Creates printer formatting file for NELIST}
  3.  
  4. Type
  5.    Str48    =      string[48];
  6.    Str11    =      string[11];
  7.    Tpface   =      (UndB, UndE, DblB, DblE,EmphB,EmphE,SmallB,SmallE,FF);
  8.    ByteLine =      array[0..3] of byte;
  9.    Bytes    =      array [UndB..FF] of ByteLine;
  10.    Fil      =      File of ByteLine;
  11.  
  12. Var
  13.    F:              Fil;
  14.    I:              integer;
  15.    Line:           Str48;
  16.    Okay,GotFile:   boolean;
  17.    T:              Tpface;
  18.    Lin:            Str11;
  19.    Inst:           Bytes;
  20.  
  21. Procedure Rectangle;                                                  {.CP23}
  22. Var
  23.    I: integer;
  24.    HorU,HorL: string[61];
  25.  
  26. Begin
  27.    LowVideo;
  28.    HorU := ''; HorL := '';
  29.    For I := 1 to 61 do HorU := HorU + #220;
  30.    For I := 1 to 61 do HorL := HorL + #223;
  31.    gotoxy(10,5);
  32.    write(HorU);
  33.    For I := 6 to 19 do
  34.    Begin
  35.       GotoXY(10,I); write(#219);
  36.       GotoXY(70,I); write(#219);
  37.    End;
  38.    GotoXY(10,20); write(HorL);
  39.    HighVideo;
  40.    GotoXY(24,3);  write('Printer Instruction Installation');
  41.    GotoXY(28,4);  write('For NELIST Pascal Lister');
  42.    GotoXY(31,21); write('Facit: R. N. Wisan')
  43. End; {Rectangle}
  44.  
  45. Procedure BlankLine (Line: integer);                                   {.CP7}
  46. Var
  47.    I:              integer;
  48. Begin
  49.    GotoXY(11,Line);
  50.    For I := 1 to 58 do write(' ')
  51. End; {Blank}
  52.  
  53. Procedure Blank (Top,Bottom: integer);                                 {.CP6}
  54. Var
  55.    I:              integer;
  56. Begin
  57.    For I := Top to Bottom do Blankline(I)
  58. End; {Blank}
  59.  
  60. Procedure PrintLine (Row: integer; Line: Str48);                       {.CP5}
  61. Begin
  62.    GotoXY(40-Length(Line) div 2,Row);
  63.    Write(Line);
  64. End; {PrintLine}
  65.  
  66. Procedure ReadFile;                                                   {.CP17}
  67. Var
  68.    I:              integer;
  69.    B:              byte;
  70. Begin
  71.    {$I-} Reset(F) {$I+};
  72.    If IOresult=0 then Begin
  73.       For T := UndB to FF do
  74.          If not Eof(F) then Read(F,Inst[T]);
  75.       Close(F);
  76.       GotFile := TRUE;
  77.    End {if}
  78.    Else Begin
  79.       GotFile := FALSE;
  80.       GotoXY(1,23)
  81.    End; {else}
  82. End; {ReadFile}
  83.  
  84. Procedure GetDat;                                                   {.CP26}
  85. Var
  86.    I:              integer;
  87.    Ans:            char;
  88.    Tstring:        String[28];
  89.  
  90.    Procedure Intro;
  91.    Begin
  92.       BlankLine(12);
  93.       If Not GotFile then PrintLine(7,'NEPRN.DAT not found');
  94.       PrintLine(9, 'We''ll go through the Printer instructions, one');
  95.       PrintLine(10,'by one using ASCII numbers (not characters).  ');
  96.       If GotFile then Begin
  97.          PrintLine(11, 'We''ll show what you have.  To change it, an-   ');
  98.          PrintLine(12, 'swer N, & you''ll be asked for the new number  ')
  99.       End {if}
  100.       Else Begin
  101.          PrintLine(11, 'We''ll list the printer function, and you enter');
  102.          PrintLine(12, 'the numbers you want.                         ');
  103.       End; {else}
  104.       PrintLine(14,'Remember, you can''t enter characters.  You must');
  105.       PrintLine(15,'enter ASCII numbers, separated by commas.      ');
  106.       PrintLine(16,'Press any key when ready ');
  107.       Read(Trm,Ans);
  108.       If Not GotFile then BlankLine(7)
  109.    End; {Intro}
  110.  
  111.    Procedure Parse(var Line: Str11; var Inst: ByteLine);              {.CP15}
  112.    Var
  113.       I,X,C:    integer;
  114.       Temp:     string[3];
  115.  
  116.       Procedure Strip;
  117.       Var
  118.          Ch:          char;
  119.       Begin
  120.          Ch := Copy(Line,1,1);
  121.          While (not (Ch in ['0'..'9'])) and (Length(Line)>0) do begin
  122.             Delete(Line,1,1);
  123.             If Length(Line)>0 then Ch := Copy(Line,1,1)
  124.          End; {while}
  125.       End; {Strip}
  126.  
  127.       Procedure GetDigit;                                             {.CP14}
  128.       Var
  129.          Comma:       integer;
  130.       Begin
  131.          Comma := Pos(',',Line);
  132.          If Comma=0 then Begin                   {if line has no comma}
  133.             Temp := Line;
  134.             Line := ''
  135.          End {if no comma}
  136.          else begin                              {if Line has a comma}
  137.             Temp := Copy(Line,1,comma-1);
  138.             Delete(Line,1,comma);
  139.          End {if comma}
  140.       End; {GetDigit}
  141.  
  142.    Begin                                                              {.CP18}
  143.       Okay := TRUE;
  144.       Inst[0] := 0;
  145.       For I := 1 to 3 do begin
  146.          If Length(Line)>0 then Strip;           {leading non-digits}
  147.          If Okay and (Length(Line)>0) then Begin
  148.             GetDigit;                            {Get 1st digit & Chop Line}
  149.             Val(Temp,X,C);
  150.             If X<256 then Begin
  151.                Inst[0] := I;
  152.                Inst[I] := X;
  153.             End {if Byte sized}
  154.             Else Okay := FALSE
  155.          End {if Line not zero}
  156.          Else
  157.             Inst[I] := 255
  158.       End {For I}
  159.    End; {Parse}
  160.  
  161.    Procedure TypeCase;                                                {.CP13}
  162.    Begin
  163.       Case T of
  164.          UndB:     Tstring := 'START Underlined';
  165.          UndE:     Tstring := 'STOP Underlined';
  166.          DblB:     Tstring := 'START Double-Strike';
  167.          DblE:     Tstring := 'STOP Double-Strike';
  168.          EmphB:    Tstring := 'START Emphasized';
  169.          EmphE:    Tstring := 'STOP Emphasized';
  170.          SmallB:   Tstring := 'START Elite (or other small)';
  171.          SmallE:   Tstring := 'STOP Elite (or other small)'
  172.       End {case}
  173.    End; {TypeCase}
  174.  
  175.    Procedure MakeLine;                                                {.CP11}
  176.    Var
  177.       Digits:      string[3];
  178.    Begin
  179.       Line := '';
  180.       For I := 1 to Inst[T,0] do begin
  181.          Str(Inst[T,I],Digits);
  182.          Line := Line + Digits + ', '
  183.       End; {For I}
  184.       If Line = '' then Line := '[Nothing]  '
  185.    End; {MakeLine}
  186.  
  187.    Procedure Ask;                                                     {.CP24}
  188.    Var
  189.       Ans:         char;
  190.    Begin
  191.       If GotFile then Begin
  192.          Blank(9,16);
  193.          PrintLine(9,'This is what you have for');
  194.          PrintLine(11,Tstring + ' type:');
  195.          MakeLine;
  196.          PrintLine(13,Line);
  197.          PrintLine(15,'Is that Okay?  (Y or N) ');
  198.          Read(Trm,Ans);
  199.          If not (Ans in ['Y','y','N','n']) then Ask
  200.       End {if GotFile}
  201.       Else Ans := 'N';
  202.       If Ans in ['N','n'] then Begin
  203.          Okay := FALSE;
  204.          Blank(9,16);
  205.          PrintLine(10, 'What does your printer need to');
  206.          PrintLine(12,Tstring+' type?');
  207.          GotoXY(35,14); Read(Lin)
  208.       End {if No}
  209.       Else Okay := TRUE
  210.    End; {Ask}
  211.  
  212.    Procedure CheckAns;                                                {.CP17}
  213.    Var
  214.       I:           integer;
  215.       Ans:         Char;
  216.       AskLine:     Str48;
  217.    Begin
  218.       Blank(9,15);
  219.       PrintLine(9,'Is this what you need to');
  220.       PrintLine(11,Tstring + ' type?');
  221.       MakeLine;
  222.       PrintLine(13,Line);
  223.       PrintLine(15, '(Ans Y or N) ');
  224.       Read(Trm,Ans);
  225.       If Ans in ['Y','y'] then Okay := TRUE
  226.       Else if Ans in ['N', 'n'] then Okay := FALSE
  227.       Else CheckAns
  228.    End; {CheckAns}
  229.  
  230.    Procedure GetPager;                                                {.CP20}
  231.    Var
  232.       I:           integer;
  233.       Pager:       string[3];
  234.  
  235.       Procedure CheckPager;
  236.       Begin
  237.          Blank(8,13);
  238.          If Inst[FF,1]=12 then begin
  239.             PrintLine(9, 'To make the printer feed out a new page,');
  240.             PrintLine(10,'you want to send ASCII character #12 ("FF").');
  241.          End {if}
  242.          Else begin
  243.             Str(Inst[FF,1],Pager);
  244.             PrintLine(10,'Your printer gets exactly '+Pager+' lines per page');
  245.          End; {else}
  246.          PrintLine(12,'Correct? '); Read(trm,Ans);
  247.          If Ans in ['N','n'] then GetPager
  248.          Else if not (Ans in ['Y','y']) then CheckPager;
  249.       End; {CheckPager}
  250.  
  251.       Procedure GetNewPager;                                          {.CP19}
  252.       Begin
  253.          Blank(9,15);
  254.          PrintLine(9,'Does your printer advance to new page');
  255.          PrintLine(10,'on ASCII Character #12 ("FF")?');
  256.          PrintLine(12,'(Answer Y or N) '); Read(Trm,Ans);
  257.          If Ans in ['Y','y'] then
  258.             Inst[FF,1] := 12
  259.          Else if Not (Ans in ['N','n']) then begin
  260.             PrintLine(8, 'Unclear.  Say again, please:');
  261.             GetPager
  262.          End {else if}
  263.          Else Begin
  264.             Blank(8,13);
  265.             PrintLine(9,'How many lines does your printer');
  266.             PrintLine(10,'put on each page? ');
  267.             Read(Inst[FF,1])
  268.          End {else}
  269.       End; {GetNewPager}
  270.  
  271.    Begin {GetPager}                                                   {.CP20}
  272.       If GotFile then Begin
  273.          Blank(9,15);
  274.          If Inst[FF,1]=12 then begin
  275.             PrintLine(9, 'To feed out a page, you now send');
  276.             PrintLine(10,'ASCII Character #12 ("FF")      ');
  277.          End {if Chr 12}
  278.          Else begin
  279.             Str(Inst[FF,1],Pager);
  280.             PrintLine(9, 'You''re not using ASCII Character #12');
  281.             PrintLine(10,'You''re counting '+Pager+' lines per page')
  282.          End; {else}
  283.          PrintLine(12,'Is that Okay? '); Read(trm,ans);
  284.          If not (Ans in ['N','n','Y','y']) then GetPager;
  285.       End {if GotFile}
  286.       Else Ans := 'N';
  287.       If Ans in ['N','n'] then GetNewPager;
  288.       CheckPager;
  289.       Inst[FF,0] := 255; For I := 2 to 3 do Inst[FF,I] := 255
  290.    End; {GetPager}
  291.  
  292. Begin {GetDat}                                                        {.CP15}
  293.    Intro;
  294.    For T:= UndB to SmallE do Begin
  295.       TypeCase;
  296.       Repeat
  297.          Ask;
  298.          If not Okay then begin
  299.             Parse(Lin,Inst[T]);
  300.             CheckAns
  301.          End {If not Okay}
  302.       Until Okay;
  303.    End; {For T}
  304.    BlankLine(8);
  305.    GetPager;
  306. End; {GetDat}
  307.  
  308. Procedure MakeFile;                                                    {.CP6}
  309.    Begin
  310.       Rewrite(F);
  311.       For T := UndB to FF do write(F,Inst[T]);
  312.       Close(F)
  313.    end; {MakeFile}
  314.  
  315. Procedure ByeBye;                                                      {.CP6}
  316. Begin
  317.    Blank(9,16);
  318.    PrintLine(10, 'New data stored in NEPRN.DAT');
  319.    PrintLine(12, 'All Finished. -- Signing off.')
  320. End; {ByeBye}
  321.  
  322. Begin {Main}                                                           {.CP9}
  323.    Rectangle;
  324.    Assign(F,'NEPRN.DAT');
  325.    ReadFile;
  326.    GetDat;
  327.    MakeFile;
  328.    ByeBye;
  329.    GotoXY(1,23)
  330. end.